home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gwu / 0b.c < prev    next >
C/C++ Source or Header  |  1996-01-30  |  21KB  |  929 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #include "hdr.h"
  11. #include "vars.h"
  12. #include "dbxp.h"
  13. #include "errmsgp.h"
  14. #include "dclmapp.h"
  15. #include "miscp.h"
  16. #include "smiscp.h"
  17. #include "chapp.h"
  18. #include <ctype.h>
  19. /* ctype.h needed for isupper, tolower, etc in 4.2 bsd*/
  20.  
  21. void adasem(Node node)                                            /*;adasem*/
  22. {
  23.     /* This is the driver routine for  all semantic processing. It is called
  24.      * by  the parser  whenever the syntax    tree  for a compilation unit has
  25.      * been built. The input  to this routine  is an AST node,  on which two
  26.      * maps are defined : AST, and SPANS. These maps are global to the front
  27.      * end.
  28.      */
  29.  
  30.     Node    n1, n2, n3, n4;
  31.     char    *id, *op_id;
  32.     Fortup    ft1;
  33.     Tuple    tup;
  34.     Node    decl_node, id_node, l;
  35.     Symbol    package, s1;
  36.  
  37.     if (cdebug2 > 2) {
  38.         /*    TO_ERRFILE("node type ");*/
  39. #ifdef IBM_PC
  40.         printf("node type: %s %d %p\n", kind_str(N_KIND(node)), N_KIND(node),
  41.           node);
  42. #else
  43.         printf("node type: %s %d %ld\n", kind_str(N_KIND(node)), N_KIND(node),
  44.           node);
  45. #endif
  46.     }
  47.  
  48.     /* The current node is placed in a global variable, from which the error
  49.      * routines can extract its span.
  50.      */
  51.     current_node = node;
  52.  
  53. #ifdef DEBUG
  54.     if (trapns>0 && N_SEQ(node) == trapns && N_UNIT(node) == trapnu)trapn(node);
  55. #endif
  56.     switch(N_KIND(node)) {
  57.  
  58.     /* Chapter 2. Lexical elements*/
  59.  
  60.     /* pragma  ->  [as_pragma  identifier argument_list]*/
  61.     case(as_pragma):
  62.         process_pragma(node);
  63.         break;
  64.  
  65.     /* argument_association     ->  [as_arg  identifier  expression]*/
  66.     case(as_arg):
  67.         break;            /*Unpacked in process_pragmas.*/
  68.  
  69.     /* Chapter 3. Declarations and types */
  70.  
  71.     /*  object_declaration ->  [as_obj_decl    identifier_list subtype_indic
  72.      *                            opt_expression]
  73.      */
  74.     case(as_obj_decl):
  75.         obj_decl(node);
  76.         break;
  77.  
  78.     /* const_declaration  ->  ['const_decl' identifier_list subtype_indic
  79.      *                            opt_expression]
  80.      */
  81.     case(as_const_decl):
  82.         const_decl(node);
  83.         break;
  84.  
  85.     /* num_declaration    ->  ['num_decl'  identifier_list expression]*/
  86.     case(as_num_decl):
  87.         number_decl(node);
  88.         break;
  89.  
  90.     /* type_decl  ->  ['type_decl' identifier discriminant_list
  91.      *                            type_definition]
  92.      */
  93.     case(as_type_decl):
  94.         type_decl(node);
  95.         break;
  96.  
  97.     /* Subtype_decl ->  ['subtype_decl' identifier subtype_indic]*/
  98.     case(as_subtype_decl):
  99.         subtype_decl(node);
  100.         break;
  101.  
  102.     /* subtype_indication  ->  ['subtype_indic', name opt_constraint]*/
  103.     case(as_subtype_indic):
  104.         /*[name, opt_constraint] := N_AST(node);*/
  105.         adasem(N_AST1(node));
  106.         adasem(N_AST2(node));
  107.         break;
  108.  
  109.     /* derived_type_definition  -> ['derived_type'    subtype_indication]*/
  110.     case(as_derived_type):
  111.         break;
  112.  
  113.     /* discrete_range  ->  ['range' expression  expression]*/
  114.     case(as_range):
  115.         /*[expression1, expression2] := N_AST(node);*/
  116.         adasem(N_AST1(node));
  117.         adasem(N_AST2(node));
  118.         break;
  119.  
  120.     /* range_attribute ->  ['range_attribute' name range]*/
  121.     case(as_range_attribute):
  122.         N_KIND(node) = as_attribute;
  123.         n2 = N_AST3(node);
  124.         find_old(node);
  125.         adasem(n2);
  126.         break;
  127.  
  128.     /* discrete_range  ->  ['range_expression'  expression]*/
  129.     case(as_range_expression):
  130.         adasem(N_AST1(node));
  131.         break;
  132.  
  133.     /* constraint  ->  ['constraint'  general_aggregate]*/
  134.     case(as_constraint):
  135.         sem_list(node);
  136.         break;
  137.  
  138.     /* enumeration_type  -> [as_enum  enumeration_literal_list]*/
  139.     case(as_enum):
  140.         sem_list(node);
  141.         break;
  142.  
  143.     case(as_int_type):
  144.         break;
  145.  
  146.     case(as_float_type):
  147.         break;
  148.  
  149.     case(as_fixed_type):
  150.         break;
  151.  
  152.     case(as_digits):
  153.     case(as_delta):
  154.         adasem(N_AST1(node));
  155.         adasem(N_AST2(node));
  156.         break;
  157.  
  158.     /* array_type_definition -> ['array_type' index_list subtype_indication]*/
  159.     case(as_array_type):
  160.         array_typedef(node);
  161.         break;
  162.  
  163.     /* subtype_definition  ->  ['box'  name]*/
  164.     case(as_box):
  165.         adasem(N_AST1(node));
  166.         break;
  167.  
  168.     /* discrete_range -> [as_subtype opt_name  range_constraint]
  169.      * general_component_association ->[as_subtype opt_name range-constraint]
  170.      */
  171.     case(as_subtype):
  172.         /*[opt_name, range_constraint] := N_AST(node);*/
  173.         n1 = N_AST1(node);
  174.         n2 = N_AST2(node);
  175.         if (n1 != OPT_NODE) {
  176.             adasem(n1);
  177.             find_old(n1);
  178.         }
  179.         if (n2 == OPT_NODE) {    /* possible, if syntax error */
  180.             N_KIND(node) = as_name;
  181.         }
  182.         else adasem(n2);
  183.         break;
  184.  
  185.     /* record_decl    -> [as_record component_list]*/
  186.     case(as_record):
  187.         adasem(N_AST1(node));
  188.         break;
  189.  
  190.     /* component_list  -> [ 'component_list'  component_decl_list variant]*/
  191.     case(as_component_list):
  192.         /*[component_decl_list, variant] := N_AST(node);*/
  193.         sem_list(N_AST1(node));
  194.         adasem(N_AST2(node));
  195.         break;
  196.  
  197.     /* component_declaration -> ['field' identifier_list subtype_indic
  198.      *                             opt_expression]
  199.      */
  200.     case(as_field):
  201.         comp_decl(node);
  202.         break;
  203.  
  204.     /* discr_specification -> ['discr_spec' identifier_list name opt_expr]*/
  205.     case(as_discr_spec):
  206.         /*[id_list_node, name, opt_expr] := N_AST(node);*/
  207.         adasem(N_AST2(node));
  208.         /*  adasem(N_AST3(node));   */
  209.         break;
  210.  
  211.     /* variant_part -> ['variant_decl' simple_name variant_list]*/
  212.     case(as_variant_decl):
  213.         variant_decl(node);
  214.         break;
  215.  
  216.     /* component_association -> ['choice_list'  choice_list     expression]*/
  217.     case(as_choice_list):
  218.         /*[choice_list, expression] := N_AST(node);*/
  219.         sem_list(N_AST1(node));
  220.         adasem(N_AST2(node));
  221.         break;
  222.  
  223.     case(as_simple_choice):
  224.         adasem(N_AST1(node));
  225.         break;
  226.  
  227.     case(as_range_choice):
  228.         adasem(N_AST1(node));
  229.         break;
  230.  
  231.     case(as_others_choice):
  232.         break;
  233.  
  234.     case(as_choice_unresolved):
  235.         adasem(N_AST1(node));
  236.         break;
  237.  
  238.     case(as_access_type):
  239.         n1 = N_AST1(node);
  240.         adasem(n1);
  241.         n2 = N_AST1(n1);
  242.         n3 = N_AST2(n1);
  243.         if (n3 == OPT_NODE ) {
  244.             /*Special case: type mark may be an incomplete type.*/
  245.             N_UNQ(n1) = find_type(n2);
  246.         }
  247.         else {    /* elaborate subtype indication*/
  248.             N_UNQ(n1) = promote_subtype(make_subtype(n1));
  249.         }
  250.         break;
  251.  
  252.     /* incomplete_type_decl -> ['incomplete_decl'  identifier  discriminant]*/
  253.     case(as_incomplete_decl):
  254.         incomplete_decl(node);
  255.         break;
  256.  
  257.     /* declarations -> ['declarations'  declaration_list]*/
  258.     case(as_declarations):
  259.         declarative_part(node);
  260.         break;
  261.  
  262.     /* Chapter 4. Names and expressions */
  263.  
  264.     /* name     -> ['character_literal'   character]
  265.      * Character literals also appear as enumeration literals, and as
  266.      * selectors.
  267.      */
  268.     case(as_character_literal):
  269.         break;
  270.  
  271.     /* name      ->  ['simple_name'  identifier]*/
  272.     case(as_simple_name):
  273.         break;
  274.  
  275.     /* name      ->  ['call?'    name  general_aggregate]*/
  276.     case(as_call_unresolved):
  277.         n1 = N_AST1(node);
  278.         n2 = N_AST2(node);
  279.  
  280.         if (N_KIND(n1) == as_string) {
  281.             /* Operator designator: reduce to lower case.*/
  282.             /*N_VAL(n1) = LOWER_CASE_OF(N_VAL(n1));*/
  283.             id = N_VAL(n1);
  284.             while(*id) {
  285.                 if (isupper(*id)) *id = tolower(*id);
  286.                 id++;
  287.             }
  288.         }
  289.         adasem(n1);
  290.         FORTUP(n1 = (Node), N_LIST(n2), ft1);
  291.             adasem(n1);
  292.         ENDFORTUP(ft1);
  293.         break;
  294.  
  295.     /* name ->  ['operator'     operator_symbol]*/
  296.     case(as_operator):
  297.         N_KIND(node) = as_simple_name;
  298.         break;
  299.  
  300.     case(as_string):
  301.         N_KIND(node) = as_simple_name;
  302.         break;
  303.  
  304.     /* name     ->  ['.' name selector]*/
  305.     case(as_selector):
  306.         adasem(N_AST1(node));
  307.         break;
  308.  
  309.     case(as_all):
  310.         adasem(N_AST1(node));
  311.         break;
  312.  
  313.     case(as_attribute):
  314.         adasem(N_AST2(node));
  315.         adasem(N_AST3(node));
  316.         break;
  317.  
  318.     /* aggregate  ->  [as_aggregate expression_list]*/
  319.     case(as_aggregate):
  320.         sem_list(node);
  321.         break;
  322.  
  323.     /* parenthesised_expression  ->     ['()', expression]*/
  324.     case(as_parenthesis):
  325.         adasem(N_AST1(node) );
  326.         break;
  327.  
  328.     /* expression  ->  [operator_designator     <expression..>]*/
  329.     case(as_op):
  330.     case(as_un_op):
  331.         /*[op_node, arg_list] := N_AST(node);*/
  332.         n1 = N_AST1(node);
  333.         op_id = N_VAL(n1);
  334.         /* KLUDGE until parser fixed. */
  335.         if (streq(op_id, "NOT")) N_VAL(n1) = strjoin("not", "");
  336.         else if (streq(op_id, "AND")) N_VAL(n1) = strjoin("and", "");
  337.         else if (streq(op_id, "XOR")) N_VAL(n1) = strjoin("xor", "");
  338.         else if (streq(op_id, "REM")) N_VAL(n1) = strjoin("rem", "");
  339.         else if (streq(op_id, "MOD")) N_VAL(n1) = strjoin("mod", "");
  340.         else if (streq(op_id, "OR"))  N_VAL(n1) = strjoin("or", "");
  341.         n2 = N_AST2(node);
  342.         find_old(n1);
  343.  
  344.         FORTUP(n3 = (Node), N_LIST(n2), ft1);
  345.             adasem(n3);
  346.             /*
  347.              * the call to check_range_attribute is useless, since
  348.              * adasem converts as_range_attribute to as_attribute
  349.              *                (gcs 11 feb)
  350.              */
  351.             /* check_range_attribute(n3); */
  352.         ENDFORTUP(ft1);
  353.         break;
  354.  
  355.     case(as_in):
  356.     case(as_notin):
  357.  
  358.         n3 = N_AST2(node);
  359.         tup = N_LIST(n3);
  360.         n1 = (Node) tup[1];
  361.         n2 = (Node) tup[2];
  362.         adasem(n1);
  363.         adasem(n2);
  364.         break;
  365.  
  366.     case(as_int_literal):
  367.         break;
  368.  
  369.     case(as_real_literal):
  370.         break;
  371.  
  372.     case(as_string_literal):
  373.         break;
  374.  
  375.     case(as_null):
  376.         break;
  377.  
  378.     case(as_name):
  379.         adasem(N_AST1(node));
  380.         break;
  381.  
  382.     case(as_qualify):
  383.         find_type(N_AST1(node));
  384.         adasem(N_AST2(node));
  385.         break;
  386.  
  387.     /* allocator  -> ['new_init' name aggregate]*/
  388.     case(as_new_init):
  389.         n1 = N_AST1(node);
  390.         n2 = N_AST2(node);
  391.         adasem(n1);
  392.         adasem(n2);
  393.         break;
  394.  
  395.     /* allocator  ->  ['new'  name    constraint_list]*/
  396.     case(as_new):
  397.         n1 = N_AST1(node);
  398.         n2 = N_AST2(node);
  399.         adasem(n1);
  400.         sem_list(n2);
  401.         break;
  402.  
  403.     /* Chapter 5. Statements*/
  404.  
  405.     /* sequence_of_statements  ->  ['statements' statement_list, label_list]*/
  406.     case(as_statements):
  407.         statement_list(node);
  408.         break;
  409.  
  410.     /* statement  ->  ['statement'    label_list  statement]*/
  411.     case(as_statement):
  412.         /*[label_list, stmt] := N_AST(node);*/
  413.         n1= N_AST1(node);
  414.         n2= N_AST2(node);
  415.  
  416.         FORTUP(l = (Node), N_LIST(n1), ft1);
  417.             find_old(l);
  418.             if (NATURE(N_UNQ(l)) != na_label) {
  419.                 errmsg("label hidden by inner declaration", "5.1", l);
  420.             }
  421.         ENDFORTUP(ft1);
  422.  
  423.         adasem(n2);
  424.         break;
  425.  
  426.     /* labels_declaration  ->  ['labels'  label_list]*/
  427.     case(as_labels):
  428.         label_decl(node);
  429.         break;
  430.  
  431.     /* null_statement  -> [null_s']*/
  432.     case(as_null_s):
  433.         break;
  434.  
  435.  
  436.     /* assignment  -> [':='     name  expression ]*/
  437.     case(as_assignment):
  438.         assign_statement(node);
  439.         break;
  440.  
  441.     /* if_statement     ->  ['if' if_part_list opt_else]*/
  442.     case(as_if):
  443.         if_statement(node);
  444.         break;
  445.  
  446.     /* condition  ->  ['condition' expression]*/
  447.     case(as_condition):
  448.         n1 = N_AST1(node);
  449.         adasem(n1);
  450.         check_type(symbol_boolean_type, n1);
  451.         break;
  452.  
  453.     /* case_statement  ->  ['case' expression alt_list]*/
  454.     case(as_case):
  455.     case_statement(node);
  456.         break;
  457.  
  458.     /* loop_statement  ->  ['loop'    opt_loop_id iteration_rule statements]*/
  459.     case(as_loop):
  460.         loop_statement(node);
  461.         break;
  462.  
  463.     /* iteration_rule  ->  ['while'     condition]*/
  464.     case(as_while):
  465.         adasem(N_AST1(node));
  466.         break;
  467.  
  468.     /* iteration rule  ->  ['for'     identifier  discrete_range]*/
  469.     case(as_for):
  470.         iter_var(node);
  471.         break;
  472.  
  473.     /* iteration_rule  ->  ['forrev' identifier  discrete_range]*/
  474.     case(as_forrev):
  475.         iter_var(node);
  476.         break;
  477.  
  478.     /* block  ->  [na_block identifier declarations statements exceptions]*/
  479.     case(as_block):
  480.         new_block(node);
  481.         break;
  482.  
  483.     /* exit_statement ->  ['exit' opt_name opt_expression]*/
  484.     case(as_exit):
  485.         exit_statement(node);
  486.         break;
  487.  
  488.     /* return_statement  ->     ['return' opt_expression]*/
  489.     case(as_return):
  490.         return_statement(node);
  491.         break;
  492.  
  493.     case(as_goto):
  494.         goto_statement(node);
  495.         break;
  496.  
  497.     /* Chapter 6. Subprograms*/
  498.  
  499.     /* subprogram_declaration  ->  ['subprogram_decl', subprogram_spec]*/
  500.     case(as_subprogram_decl):
  501.         subprog_decl(node);
  502.         break;
  503.  
  504.     /* subprogram_specification -> [na_procedure identifier formals_list]
  505.      *               -> [na_function  identifier formals_list name]
  506.      */
  507.     case(as_procedure):
  508.         break;
  509.  
  510.     case(as_function):
  511.         find_type(N_AST3(node));
  512.         break;
  513.  
  514.     /* subprogram_body  ->    ['subprogram' subprogram_spec  declarations
  515.      *                       statements opt_exceptions]
  516.      */
  517.     case(as_subprogram):
  518.         subprog_body(node);
  519.         break;
  520.  
  521.     /* parameter_specification -> ['formal' id_list mode name opt_expression]*/
  522.     case(as_formal):
  523.         break;
  524.  
  525.     /* mode     -> ['mode'  identifier]*/
  526.     case(as_mode):
  527.         break;
  528.  
  529.     /* call_statement -> ['call' name]*/
  530.     case(as_call):
  531.         call_statement(node);
  532.         break;
  533.  
  534.     /* Chapter 7. Packages*/
  535.  
  536.     /* package_specification  ->  [na_package_spec identifier declarations
  537.      *                              opt_private_part]
  538.      */
  539.     case(as_package_spec):
  540.         package_specification(node);
  541.         break;
  542.  
  543.     /* package_body     ->  ['package_body' identifier declarations
  544.      *                     opt_statements     opt_handler]
  545.      */
  546.     case(as_package_body):
  547.         id_node = N_AST1(node);
  548.         decl_node = N_AST2(node);
  549.         n3 = N_AST3(node);
  550.         n4 = N_AST4(node);
  551.         module_body_id(na_package, id_node);
  552.         adasem(decl_node);
  553.         adasem(n3);
  554.         adasem(n4);
  555.         force_all_types();
  556.         module_body(na_package, node);
  557.         package = N_UNQ(id_node);
  558.         if (NATURE(package) == na_generic_package)
  559.             N_KIND(node) = as_generic_package;
  560.         break;
  561.  
  562.     /* private_type_declaration  ->     ['private_decl' identifier
  563.      *                      discriminant_list priv_kind]
  564.      */
  565.     case(as_private_decl):
  566.         private_decl(node);
  567.         break;
  568.  
  569.     /* Chapter 8. Visibility rules*/
  570.  
  571.     /* use_clause  -> [use' identifier_list]*/
  572.     case(as_use):
  573.         use_clause(node);
  574.         break;
  575.  
  576.     /* renaming_declaration -> ['rename_ex' identifier name]*/
  577.     case(as_rename_ex):
  578.         rename_ex(node);
  579.         break;
  580.  
  581.     /* renaming_declaration     ->  ['rename_pack' identifier    name]*/
  582.     case(as_rename_pack):
  583.         rename_pack(node);
  584.         break;
  585.  
  586.     /* renaming_declaration     ->  ['rename_obj' identifier type_mark name]*/
  587.     case(as_rename_obj):
  588.         rename_object(node);
  589.         break;
  590.  
  591.     /* renaming declarations  ->  ['rename_sub'  subprogam_spec  name]*/
  592.     case(as_rename_sub):
  593.         rename_subprogram(node);
  594.         break;
  595.  
  596.     /* Chapter 9. Tasks */
  597.  
  598.     /* task_specification  ->  [task_kind identifier opt_entry_declaration
  599.      *                             opt_rep_clause]
  600.      * task_kind           ->  'task_spec'
  601.      *              ->  na_task_type_spec
  602.      */
  603.     case(as_task_spec):
  604.     case(as_task_type_spec):
  605.         /* clear N_AST3 as specification not supported now, and
  606.          * need this field for N_TYPE   DS 9-21-86
  607.          */
  608.         N_AST3(node) = (Node)0;
  609.         task_spec(node);
  610.         break;
  611.  
  612.     /* task_body  ->  ['task' identifier declarations statements
  613.      *                            opt_exceptions]
  614.      */
  615.     case(as_task):
  616.         /*[id_node, decls, stmts, excepts] := N_AST(node);*/
  617.         id_node = N_AST1(node);
  618.         n2 = N_AST2(node);
  619.         n3 = N_AST3(node);
  620.         n4 = N_AST4(node);
  621.         module_body_id(na_task_type, id_node);
  622.         /* clear the private_decls field set in module_body_id as this is */
  623.         /* irrelevant to tasks. */
  624.         private_decls(N_UNQ(id_node)) = (Set)0;
  625.         adasem(n2);
  626.         adasem(n3);
  627.         adasem(n4);
  628.         module_body(na_task_type, node);
  629.         s1 = N_UNQ(id_node);
  630.         check_incomplete_decls(s1, node);
  631.         break;
  632.  
  633.     /* entry_declaration   ->  [na_entry identifier formals_list]*/
  634.     case(as_entry):
  635.         entry_decl(node);
  636.         break;
  637.  
  638.     /* * entry_declaration   ->  [na_entry_family identifier discrete_range
  639.      *                               formals_list]
  640.      */
  641.     case(as_entry_family):
  642.         entry_family_decl(node);
  643.         break;
  644.  
  645.     /* accept_statement  ->     ['accept' name opt_expression opt_formal_part
  646.      *                              opt_statements]
  647.      */
  648.     case(as_accept):
  649.         accept_statement(node);
  650.         break;
  651.  
  652.     /* delay_statement  -> ['delay'     expression]*/
  653.     case(as_delay):
  654.         n1 = N_AST1(node);
  655.         adasem(n1);
  656.         check_type(symbol_duration, n1);
  657.         break;
  658.  
  659.     /* selective_wait  ->  ['selective_wait' alternative_list else_part]*/
  660.     case(as_selective_wait):
  661.         n1 = N_AST1(node);
  662.         n2 = N_AST2(node);
  663.         sem_list(n1);
  664.         if (n2 != OPT_NODE)
  665.             adasem(n2);
  666.         break;
  667.  
  668.     /* select_alternative -> ['guard' condition selective_wait_alternative]*/
  669.     case(as_guard):
  670.         adasem(N_AST1(node));
  671.         adasem(N_AST2(node));
  672.         break;
  673.  
  674.     /* selective_wait_alternative -> ['accept_alt' accept_statement opt_stats]
  675.      *                 -> ['delay_alt'  delay_statement  opt_stats]
  676.      */
  677.     case(as_accept_alt):
  678.         adasem(N_AST1(node));
  679.         adasem(N_AST2(node));
  680.         break;
  681.  
  682.     case(as_delay_alt):
  683.         adasem(N_AST1(node));
  684.         adasem(N_AST2(node));
  685.         break;
  686.  
  687.     /* selective_wait_alternative  -> ['terminate_alt' ]*/
  688.     case(as_terminate_alt):
  689.         terminate_statement(node);
  690.         break;
  691.  
  692.     /* conditional_entry_call -> ['conditional_entry_call' call_statement
  693.      *                        statements else_stat]
  694.      */
  695.     case(as_conditional_entry_call):
  696.         check_entry_call(N_AST1(node));
  697.         adasem(N_AST2(node));
  698.         adasem(N_AST3(node));
  699.         break;
  700.  
  701.     /* timed_entry_call -> ['timed_entry_call', call_statement statements
  702.      *                           delay_alternative]
  703.      */
  704.     case(as_timed_entry_call):
  705.         check_entry_call(N_AST1(node));
  706.         adasem(N_AST2(node));
  707.         adasem(N_AST3(node));
  708.         break;
  709.  
  710.     /* abort_statement  -> ['abort'     task_name_list]*/
  711.     case(as_abort):
  712.         abort_statement(node);
  713.         break;
  714.  
  715.     /* Chapter 10. Program structure...*/
  716.  
  717.     /* (as_compilation):
  718.      * This node is used for pragmas that precede a compilation unit.
  719.      * TBSL
  720.      */
  721.  
  722.     /* unit_declaration  ->     ['unit' context_clause     unit_body]*/
  723.     case(as_unit):
  724.         compunit(node);
  725.         break;
  726.  
  727.     /* context_clause  -> ['with_use_list' [with_or_use...]]
  728.      * No action is necessary since this is handled in comp_unit
  729.      * body_stub    ->  ['subprogam_stub' subprogram_specification]
  730.      *           ->  ['package_stub'  name]
  731.      *           ->  ['task_stub'        name]
  732.      */
  733.  
  734.     case(as_subprogram_stub):
  735.         {
  736.             Symbol u_name;
  737.             n1 = N_AST1(node);
  738.             n2 = N_AST1(n1);
  739.             u_name = dcl_get(DECLARED(scope_name), N_VAL(n2));
  740.             /* For generic stubs ignore call to check_spec. 
  741.              * TBSL: code for checking formals.
  742.              * Note: if uname is undefined here it indicates that the stub had
  743.              * no subprog declaration and therefore is certainly not generic.
  744.              */
  745.             if (u_name != (Symbol)0
  746.               && (NATURE(u_name) == na_generic_procedure_spec
  747.               || NATURE(u_name) == na_generic_function_spec)) {
  748.                 N_UNQ(n2) = u_name;
  749.                 newscope(u_name);
  750.                 adasem(n1);
  751.                 popscope();
  752.                 save_stub(node);
  753.             }
  754.             else {
  755.                 adasem(n1);
  756.                 check_spec(node);
  757.                 u_name = N_UNQ(n2);
  758.                 NATURE(u_name) = N_KIND(n1) == as_procedure ? na_procedure_spec
  759.                   : na_function_spec;
  760.                 if (in_op_designators(ORIG_NAME(u_name) ) ){
  761.                     errmsg_l("Name of separately compiled unit cannot be ",
  762.                       "an operator designator", "10.1", n2);
  763.                 }
  764.                 else {
  765.                     save_stub(node);
  766.                 }
  767.             }
  768.         }
  769.         break;
  770.  
  771.     case(as_package_stub):
  772.         stub_head(na_package, node);
  773.         save_stub(node);
  774.         break;
  775.  
  776.     case(as_task_stub):
  777.         stub_head(na_task, node);
  778.         save_stub(node);
  779.         break;
  780.  
  781.     /* subunit  -> ['separate' parent_name unit]*/
  782.     case(as_separate):
  783.         adasem(N_AST2(node));
  784.         break;
  785.  
  786.     /* Chapter 11. Exceptions*/
  787.  
  788.     /* Exception_declaration  ->  ['except_decl'  identifier_list]*/
  789.     case(as_except_decl):
  790.         except_decl(node);
  791.         break;
  792.  
  793.     /* exceptions  -> ['exception' handler_list]*/
  794.     case(as_exception):
  795.         exception_part(node);
  796.         break;
  797.  
  798.     /* exception_handler  ->  ['handler'  exception_choice_list statements]*/
  799.     case(as_handler):
  800.         exception_handler(node);
  801.         break;
  802.  
  803.     case(as_others):
  804.         break;
  805.  
  806.     /* raise_statement -> ['raise  opt_identifier]*/
  807.     case(as_raise):
  808.         raise_statement(node);
  809.         break;
  810.  
  811.     /* Chapter 12. Generics*/
  812.     case(as_generic_procedure):
  813.     case(as_generic_function):
  814.         generic_subprog_spec(node);
  815.         break;
  816.  
  817.     case(as_generic_package):
  818.         generic_pack_spec(node);
  819.         break;
  820.  
  821.     /* Generic part     ->  ['generic_formals' generic_decl_list]*/
  822.     case(as_generic_formals):
  823.         /*$$$newtypes with:= []; $ Anonymous types may be created (???)*/
  824.         sem_list(node);
  825.         /*$$$ generic_list := []+/sem_list(2);     and new_type_list*/
  826.         break;
  827.  
  828.     /* Generic_formal -> ['generic_obj' id_list mode name opt_expression]*/
  829.     case(as_generic_obj):
  830.         generic_obj_decl(node);
  831.         break;
  832.  
  833.     /* Generic formal  -> ['generic_type' identifier type_def]*/
  834.     case(as_generic_type):
  835.         generic_type_decl(node);
  836.         break;
  837.  
  838.     /* Generic formal  -> ['gen_priv_type'    private_type_declaration]*/
  839.     case(as_gen_priv_type):
  840.         generic_priv_decl(node);
  841.         break;
  842.  
  843.     /* Generic_formal   ->    ['generic_subp', subprogram_spec  opt_is]*/
  844.     case(as_generic_subp):
  845.         generic_subp_decl(node);
  846.         break;
  847.  
  848.     /* Generic_type_definition  ->    ['generic' identifier]*/
  849.     case(as_generic):
  850.         break;
  851.  
  852.     /* Package_instance -> ['package_instance' identifier name instance_list]*/
  853.     case(as_package_instance):
  854.         package_instance(node);
  855.         break;
  856.  
  857.     /* subprogram_instance
  858.      *    ->  ['function_instance'  designator  name  generic_actual_part]
  859.      *    ->  ['procedure_instance' identifier  name  generic_actual_part]
  860.      */
  861.     case(as_function_instance):
  862.     case(as_procedure_instance):
  863.         subprog_instance(node);
  864.         break;
  865.  
  866.     /* generic_parameter_association->['instance' opt_identifier expression]*/
  867.     case(as_instance):
  868.         break;
  869.  
  870.     /* Chapter 13. Representation specs...*/
  871.  
  872.     /* length_clause -> ['length_clause' attribute simple_expression ]*/
  873.     case(as_length_clause):
  874.         length_clause (node);
  875.         break;
  876.  
  877.     /*
  878.      * enumeration_representation_clause -> ['enum_rep_clause'
  879.      *                       simple_name aggregate ]
  880.      */
  881.     case(as_enum_rep_clause):
  882.          enum_rep_clause (node); 
  883.         break;
  884.  
  885.     /*
  886.      * record_representation_clause ->
  887.      *    ['rec_rep_clause' simple_name opt_align_clause comp_clause_list ]
  888.      */
  889.     case(as_rec_rep_clause):
  890.         rec_rep_clause(node);
  891.         break;
  892.  
  893.     /* component_clause -> ['compon_clause' name simple_expression range]*/
  894.     case(as_compon_clause):
  895.         adasem(N_AST1(node));
  896.         adasem(N_AST2(node));
  897.         adasem(N_AST3(node));
  898.         break;
  899.  
  900.     /* address_clause -> ['address_clause' simple_name simple_expression]*/
  901.     case(as_address_clause):
  902.         break;
  903.  
  904.     case(as_opt): 
  905.         break;
  906.  
  907.     case(as_line_no):
  908.         break;
  909.  
  910.     default:
  911.         if (node == (Node)0) return;
  912.         /* above is single line added re OPT_NODE  4 jul*/
  913.         printf("adasem: invalid node %d kind %d\n", node, N_KIND(node));
  914.         errmsg_str("System error: invalid node %", kind_str(N_KIND(node)),
  915.           "none", node);
  916.     }
  917. }
  918.  
  919. void sem_list(Node n)                                        /*;sem_list*/
  920. {
  921.     Fortup ft1;
  922.     Node    ln;
  923.  
  924.     if (N_LIST(n) == (Tuple)0) return;
  925.     FORTUP(ln = (Node), N_LIST(n), ft1);
  926.         adasem(ln);
  927.     ENDFORTUP(ft1);
  928. }
  929.